home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb7.arc / HEXCALC.PAS < prev    next >
Pascal/Delphi Source File  |  1985-12-01  |  4KB  |  165 lines
  1. {$V-}
  2. PROGRAM HEX;
  3. {
  4.    Copyright (c) M-SQUARED Systems, Inc.- 1984
  5.  
  6.    Permission granted for unlimited distribution and use by
  7.    individuals, so long as no charge is made for such use or
  8.    distribution.
  9.  
  10.    W.B. Malthouse
  11.    5918 Veranda Dr.
  12.    Springfield, Va. 22152
  13. }
  14.    type s4=string[4];
  15.    type pinteger=^integer;
  16.    VAR H:ARRAY[0..255] OF STRING[2];
  17.    var pp:pinteger;
  18.    var ii,jj,i,j,k:integer;
  19.    var a,b:string[255];
  20.    label 1,2,3;
  21.    VAR X,Y:REAL;
  22.    VAR N1,N2,N3,N4,N5:REAL;
  23.  
  24. PROCEDURE SETUP;
  25.    VAR T1,T2:CHAR;
  26.    VAR I,J,K:INTEGER;
  27. BEGIN;
  28.    K:=0;
  29.    FOR I:=0 TO 15 DO BEGIN;
  30.       FOR J:=0 TO 15 DO BEGIN;
  31.            IF I>9 THEN T1:=CHR(I+55)
  32.            ELSE T1:=CHR(I+48);
  33.            IF J>9 THEN T2:=CHR(J+55)
  34.            ELSE T2:=CHR(J+48);
  35.            H[K]:=T1+T2;
  36.            K:=K+1;
  37.       END;
  38.    END;
  39. END;
  40.  
  41. FUNCTION HEXWORD(j:integer): s4;
  42. type bytes=array[1..2] of byte;
  43. type bp=^bytes;
  44. var q:bp;
  45. VAR S:STRING[4];
  46. begin;
  47.    q:=addr(j);
  48.    hexword:=h[q^[2]]+h[q^[1]];
  49. end;
  50.  
  51. begin;
  52.       clrscr;
  53.       setup;
  54.       gotoxy(1,3);
  55.       writeln('                Hex Converter/Calculator Program');
  56.       writeln;
  57.       writeln('       Enter two numbers in HEX or in DECIMAL preceeded by "."');
  58.       writeln;
  59.       WRITELN('ENTER NUMBERS AT THE "N1:" AND "N2:" PROMPTS, USE "return" TO EXIT.');
  60.       repeat
  61.       1: ;
  62.       gotoxy(10,11);
  63.       write('   N1        N2     N1+N2     N1-N2     N2-N1');
  64.       gotoxy(1,20);
  65.       write('N1: ');
  66.       clreol;
  67.       gotoxy(1,21);
  68.       write('N2: ');
  69.       clreol;
  70.       gotoxy(5,20);
  71.       readln(a);
  72.       if   a='' then
  73.       else begin;
  74.            if a[1]<>'.' then a:='$'+a
  75.            else BEGIN;
  76.                 delete(a,1,1);
  77.                 VAL(A,X,K);
  78.                 IF K<>0 THEN BEGIN;
  79.                      gotoxy(20,20);
  80.                      write('Invalid Numeric Input');
  81.                      sound(220);
  82.                      delay(550);
  83.                      nosound;
  84.                      repeat; until(keypressed);
  85.                      goto 1;
  86.                 end;
  87.                 IF X>32767.0 THEN X:=X*(-1.0)+32767;
  88.                 I:=TRUNC(X);
  89.                 GOTO 2;
  90.             END;
  91.             val(a,i,k);
  92.             if k<>0 then begin;
  93.                gotoxy(20,20);
  94.                write('Invalid Numeric Input');
  95.                sound(220);
  96.                delay(550);
  97.                nosound;
  98.                repeat; until(keypressed);
  99.                goto 1;
  100.             end;
  101.  2: gotoxy(5,21);
  102.     readln(b);
  103.     if b[1]<>'.' then b:='$'+b
  104.     else BEGIN;
  105.        delete(b,1,1);
  106.        VAL(B,Y,K);
  107.        IF K<>0 THEN BEGIN;
  108.           gotoxy(20,21);
  109.           write('Invalid Numeric Input');
  110.           sound(220);
  111.           delay(550);
  112.           nosound;
  113.           repeat; until(keypressed);
  114.           goto 1;
  115.        end;
  116.        IF Y>32767.0 THEN Y:=Y*(-1.0)+32767;
  117.        j:=TRUNC(Y);
  118.        GOTO 3;
  119.     END;
  120.     val(b,j,k);
  121.     if k<>0 then begin;
  122.        gotoxy(20,21);
  123.        write('Invalid Numeric Input');
  124.        sound(220);
  125.        delay(550);
  126.        nosound;
  127.        repeat; until(keypressed);
  128.        goto 1;
  129.     end;
  130. 3:  N1:=INT(I);
  131.     N2:=INT(J);
  132.     N3:=N1+N2;
  133.     N4:=N1-N2;
  134.     N5:=N2-N1;
  135.     GOTOXY(1,13);
  136.     WRITE('HEX:');
  137.     GOTOXY(1,14);
  138.     WRITE('DEC:');
  139.     GOTOXY(5,14);
  140.     WRITE(N1:10:0,N2:10:0,N3:10:0,N4:10:0,N5:10:0);
  141.     GOTOXY(11,13);
  142.     write(hexword(i));
  143.     gotoxy(21,13);
  144.     write(hexword(j));
  145.     gotoxy(31,13);
  146.     ii:=i+j;
  147.     write(hexword(ii));
  148.     gotoxy(41,13);
  149.     jj:=i-j;
  150.     write(hexword(jj));
  151.     JJ:=J-I;
  152.     gotoxy(51,13);
  153.     write(hexword(jj));
  154.     GOTOXY(1,22);
  155.     repeat;
  156.     until(keypressed);
  157.     GOTOXY(1,13);
  158.     CLREOL;
  159.     GOTOXY(1,14);
  160.     CLREOL;
  161.  end;
  162.       until (a='');
  163.       gotoxy(1,22);
  164. end.
  165.